package ipinterfaces;

#########################################################################
#									#
# Name:	 	ipinterfaces.pm (Perl Module)				#
#									#
# Completed:	8th October, 2003.					#
#									#
# Updated:	9th December, 2009.					#
#									#
# Author:	Simon Edwards, Linuxha.net				#
#									#
# Arguments:	N/A							#
#									#
# Purpose:	This module contains a series of routines for 		#
# 		performing various checks and actions aimed at IPv4	#
# 		handling for the linuxha codebase.			#
#									#
# Limitations:	1 - Lots probably.					#
#									#
# Environment:	None.							#
#									#
# Exit Codes:	N/A							#
# 									#
#########################################################################

use Net::Ping;
eval { require "miitoollib.pm"; } ;
eval "use Net::Interface;" ;
use nethardware;
use Data::Dumper;
use Socket;

# Can take remote=>node to get details via ssh of remote node.

sub new {
my $proto=shift;
my $class=ref($proto) || $proto;
my $self={};
my %args=@_;

	$self->{MIITOOLLIB}=0;
	$self->{ETHTOOLLIB}=0;
	if(defined(&miitoollib::ethtoolquery)) {
		$self->{ETHTOOLLIB}=1;
	}
	if(defined(&miitoollib::miiquery)) {
		$self->{MIITOOLLIB}=1;
	}
	$self->{MIITOOLLIB_SEND_ARP}=defined(&miitoollib::send_arp);
	if(exists($args{remote})) {
		$self->{remote}=$args{remote};
	}
        eval '@F=Net::Interface->interfaces;';
	if(defined($F[0])) {
		$self->{NET_INTERFACES}=1;
	} else {
		$self->{NET_INTERFACES}=0;
	}
	bless($self,$class);
	scan_interfaces($self);
	return $self;
}

sub scan_interfaces {
my $self=shift;
my (%interfaces,$fd,$cint,$no,$int);
my ($ip,$bcast,$mask,$hw);

	%interfaces=();
	$self->{scantime}=time;
	if($self->{NET_INTERFACES} && !exists($self->{remote})) {
		my (@F,$MAC,$i);
		foreach $int (Net::Interface->interfaces ()) {
			$cint=$int->name;
			next if $cint eq "lo";
			if($cint !~ /:/) {
				$cint.=":0";
			}
			$interfaces{"$cint"}->{ip}=join(".", unpack("C*", $int->address));
			$interfaces{"$cint"}->{broadcast}=join(".", unpack("C*", $int->broadcast));
			$interfaces{"$cint"}->{netmask}=join(".", unpack("C*", $int->netmask));
			$interfaces{"$cint"}->{network}=_return_network($interfaces{"$cint"}->{ip},
								$interfaces{"$cint"}->{netmask});
			$MAC="";
			@F = split('', uc(unpack("H*", $int->hwaddress)));
			for($i=0;$i<scalar @F;$i+=2){
				$MAC.=($i+2<scalar @F ? "$F[$i]$F[$i+1]:" : "$F[$i]$F[$i+1]");
			}

			$interfaces{"$cint"}->{mac}=$MAC;
			$interfaces{"$cint"}->{slave}=0;
		}
		$self->{interfaces}=\%interfaces;
		return;
	}
	#################################################################
	# Use nethardware here instead of attemping ifconfig -a.	#
	#################################################################
	my $nethw=new nethardware();
	if(!defined($nethw)) {
		return; # Can not query hardware at all!
	}
	$self->{nethardware}=$nethw;
	%interfaces=();
	my @I=$nethw->list(logical=>1);
	for $cint (@I) {
		my $ref=$nethw->cardref($cint);
		if(defined($ref)) {
			$interfaces{$cint}={};
			$interfaces{$cint}->{ip}=$ref->{IPv4};
			$interfaces{$cint}->{broadcast}=$ref->{BCv4};
			$interfaces{$cint}->{netmask}=$ref->{NMv4};
			$interfaces{$cint}->{network}="";
			$interfaces{$cint}->{mac}=$ref->{HW};
			$interfaces{$cint}->{slave}=0;
			if(exists($ref->{CI})) {
				$interfaces{$cint}->{ci}=$ref->{CI};
			}
		}
	}
	$self->{interfaces}=\%interfaces;
	return;
}

#########################################################################
# This will return a list of physical or logical interfaces names	#
# Must use logical => 1 or physical => 1				#
#########################################################################

sub list {
my $self=shift;
my @nlist;
my %args=@_;

	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{logical}) && !exists($args{physical})) {
		$args{physical}=1;
	}
	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+30<time) {
		scan_interfaces($self);
	}
	if(exists($args{physical})) {
		return ($self->{nethardware}->list());
		return @I;
	}
	return ($self->{nethardware}->list(logical=>1));
}

#########################################################################
# Given an interface it will return the number of the next logical	#
# interface that can be assigned to.					#
# If an interface has 0.0.0.0 as it's primary address, then the		#
# primary interface is available.					#
#########################################################################

sub get_logical {
my $self=shift;
my %args=@_;
my ($int,$try);

	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{interface})) {
		return -1;
	}
	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+30<time) {
		scan_interfaces($self);
	}

	$int=$args{interface};
	if(!exists($self->{interfaces}->{$int}) ||
		!length($self->{interfaces}->{$int}->{ip}) ||
		(defined($self->{interfaces}->{$int}->{ip}) && 
		$self->{interfaces}->{$int}->{ip} eq "0.0.0.0")) {
		return 0;
	}
	
	$try=1;
	while(exists($self->{interfaces}->{"$int:$try"})) {
		if(defined($self->{interfaces}->{"$int:$try"}->{ip}) && 
			$self->{interfaces}->{"$int:$try"}->{ip} eq "0.0.0.0") {
			return $try;
		}
		if(!length($self->{interfaces}->{"$int:$try"}->{ip})) {
			return $try;
		}
		$try++;
	}
	return $try;
}

#########################################################################
# Given an IP address this will return the $cint:$no of the		#
# interface, or undef if no such ip address is currently assigned.	#
#########################################################################

sub get_interface {
my $self=shift;
my %args=@_;
my @d;

	#################################################################
	# 0109: Put a check here to see if multiple IP addresses	#
	#	have been passed and issue a warning if so...		#
	#################################################################
	@d=split(/,/,$args{ip});
	if(scalar(@d)>1) {
		print STDERR "GET_INTERFACE: Multiple IPs passed!\n";
		$args{ip}=(split(/,/,$args{ip}))[0];
	}
	# We check each of the entries - is appears to be a name
	# we run gethostbyname on the details...
	if($args{ip} !~ /^\d+\./) {
		my $pi=gethostbyname($args{ip});
		if(defined($pi)) {
			$args{ip}=inet_ntoa($pi);
		}
	}

	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{ip})) {
		return undef;
	}
	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+30<time) {
		scan_interfaces($self);
	}
	foreach (keys %{$self->{interfaces}}) {
		next if ! exists($self->{interfaces}->{$_}->{ip});
		next if ! defined($self->{interfaces}->{$_}->{ip});
		if($self->{interfaces}->{$_}->{ip} eq $args{ip}) {
			return $_;
		}
	}
	return undef;
}

#########################################################################
#									#
# This routine will take details of the IP information to ping and 	#
# will return the following:						#
# (1,results)	- IP interface is working as expected			#
# (0,results)	- Ping results below threshold, so might consider	#
# 		  moving the interface.					#
# (-1,str)	- Other error occured.					#
# 		  							#
# The following arguments are expected:					#
# 									#
# ips		- Optional list of ip addresses to try			#
# [succeed]	- Percentage of IP address over which the interface	#
# 		  is thought to be valid. Defaults to 100.		#
# [pingtype]	- Type of ping to use (defaults to udp).		#
# [pingtimeout]	- Timeout for ping (default to 2 seconds)		#
# [logmsg]	- Function to send log messages to.			#
# [logwarn]	- Function to send warn messages to.			#
# [usearp]	- Whether to send gratuitous arp when an IP address	#
#		  is assigned to an interface.				#
# [usesrcaddr]	- Bind the ping routine to the interface specified as	#
# 		  this variable.					#
#									#
#########################################################################

sub ip_check {
my $self=shift;
my %args=@_;
my ($ips,$succeed,$pingtype);
my ($cip,$count,$okcount,$str);
my ($pinger,$pingtimeout,$logmsg,$logwarn);
my ($srcaddr,$bindip);

	if(!exists($args{ips})) {
		return (-1,"Missing ip or interfaces argument");
	}
	if(!defined($args{ips})) {
		return (-1,"undefined ip or interfaces argument");
	}

	$ips=$args{ips};
	$succeed=$args{succeed} if exists($args{succeed});
	$pingtype=$args{pingtype} if exists($args{pingtype});
	$pingtimeout=$args{pingtimeout} if exists($args{pingtimeout});
	$logmsg=$args{logmsg} if exists($args{logmsg});
	$logwarn=$args{logwarn} if exists($args{logwarn});
	$succeed=100 if !defined($succeed);
	$pingtype="udp" if !defined($pingtype);
	$pingtimeout=2 if !defined($pingtimeout);

	if(exists($args{usesrcaddr})) {
		$srcaddr=$args{usesrcaddr};
		if(exists($self->{interfaces}->{"$srcaddr:0"}) &&
			exists($self->{interfaces}->{"$srcaddr:0"}->{ip})) {
				$bindip=$self->{interfaces}->{"$srcaddr:0"}->{ip};
		}
	}
	$count=0;
	$okcount=0;
	$pinger=Net::Ping->new($pingtype,$pingtimeout);

	#################################################################
	# We only attempt to perform the bind if the version of 	#
	# Net::Ping actually supports it - version 5.6.x do not.	#
	#################################################################

	if(defined($bindip)) {
		if(defined(&Net::Ping::bind)) {
			$pinger->bind($bindip);
		} else {
			&$logwarn("Bind method not available for Net::Ping!") if defined($logwarn);
		}
	}

	foreach $cip (split(/,/,$ips)) {
		$rc=$pinger->ping($cip);
		if($rc) {
			$okcount++;
		}
		$count++;
	}
	if($okcount/$count*100>=$succeed) {
		return (1,int($okcount/$count*100));
	} else {
		return (1,int($okcount/$count*100));
	}
}

#########################################################################
# Return the list of routes currently associated with a particular	#
# interface. It returns a list where each element is:			#
# IPDEST:GATEWAY:FLAGS:GENMASK						#
# eg: 192.168.0.0:0.0.0.0:U:255.255.255.0,0.0.0.0:192.168.0.1:UG	#
#									#
# Requires the following argument:					#
# interface:	The name of the interface to get the routes for -	#
#		such as eth0 - routine will strip of logical interface	#
#		information if passed.					#
#########################################################################

sub linkn_to_gw_nm(\@$$) {
my $lref=shift;
my $linkn=shift;
my $nh=shift;

	my $card=$lref->[$linkn-1];
	return(undef,undef) if !defined($card);

	# So we have card, get details...
	my $r=$nh->cardref($card);
	return(undef,undef) if !defined($r);
	return($r->{IPv4},$r->{NMv4});
}

sub get_routes {
my $self=shift;
my %args=@_;
my (@l,@F,$cmd,$cline,$fd,$i);

	#################################################################
	# On freebsd we need to run nethardware->physorder to get the 	#
	# order of the physical interfaces, since the link#n number	#
	# for the gateway refers to that!				#
	#################################################################
	my (@CO,$nethw);
	if($^O eq "freebsd") {
		if(!exists($self->{nethardware}) && !defined($self->{nethardware})) {
			$nethw=new nethardware();
		} else {
			$nethw=$self->{nethardware};
		}
		@CO=$nethw->card_order();
	}
	@l=();
	return() if !exists($args{interface});
	$i=$args{interface};
	$i =~ s/:.*//;
	if($^O eq "freebsd" || $^O eq "solaris" || $^O eq "hpux" || $^O eq "aix") {
		$cmd="netstat -nr -f inet|";
	} else {
		$cmd="netstat -nr|";
	}
	open($fd,$cmd) or return();
	while($cline=<$fd>) {
		chomp $cline;
		next if $cline !~ /^[0-9]{1,3}\./;
		@F=split(/\s+/,$cline);
		if($^O eq "freebsd") {
			next if $F[5] ne $i; # ignore lines for other interfaces
			if($F[1] =~ /^link#(\d+)/) {
				my $ln=$1;
				my ($ip,$nm)=linkn_to_gw_nm(@CO,$ln,$nethw);
				if(defined($ip)) {
					push @l,"$F[0]:$ip:$F[2]:$nm";
				}
			} elsif($F[1] =~ /^\d+\./) {
				push @l,"$F[0]:$F[1]:$F[2]:0.0.0.0";
			}
			next;
		}
		if($^O eq "aix") {
			if($F[0] =~ /\//) {
				next; # ignore netmask lines...
			}
			next if $F[5] ne $i; # ignore lines for other interfaces
			push @l,"$F[0]:$F[1]:$F[2]:0.0.0.0";
			next;
		}
		next if $F[$#F] ne $i;
		if($^O ne "solaris" && $^O ne "hpux") {
			push @l,"$F[0]:$F[1]:$F[3]:$F[2]";
		} else {
			push @l,"$F[0]:$F[1]:$F[2]:0.0.0.0";
		}
	}
	close($fd);
	return @l;
}

#########################################################################
# set_routes takes the list of routines in the format generated by	#
# get_routes and applies them to a particular interface.		#
# Returns a list of any routes that could not be set.			#
# If the destination already exists on that interface a new one will	#
# not be set up.							#
# Requires the following arguments:					#
# interface	The name of the interface to set the routes up on.	#
# routes	A reference to a list of routes to configure.		#
#########################################################################

sub set_routes {
my $self=shift;
my %args=@_;
my (@r,$cmd,@F,@F2,@r2,$x,$f,$i,@b);

	local $SIG{CHLD}='DEFAULT';
	@b=();
	die("Missing routes argument") if !exists($args{routes});
	@r=@{$args{routes}};
	die("Missing interface argument") if !exists($args{interface});
	$i=$args{interface};
	$i =~ s/:.*//;

	#################################################################
	# firstly get a list of current routes on the new interface.	#
	#################################################################

	@r2=get_routes($self,interface=>$i);

	for (@r) {
		@F=split(/:/,$_);
		#########################################################
		# Ensure this route is not already configured, and if	#
		# so we ignore it.					#
		#########################################################
		$f=0;
		for $x (@r2) {
			@F2=split(/:/,$x);
			if($F[0] eq $F2[0]) {
				$f=1;last;
			}
		}
		next if $f;
		# Route needs to be added, so attempt to do so.		#
		if($F[2] =~ /H/) {
			$cmd="/sbin/route add $F[0] ";
		} else {
			$cmd="/sbin/route add -net $F[0] ";
		}
		if($^O ne "solaris") {
			$cmd.="netmask $F[3] ";
		}
		$cmd.="gw $F[1] " if $F[1] ne "0.0.0.0";
		$cmd.="dev $i 2>&1";

		$r=`$cmd`;
		chomp $r;
		if($r ne "") {
			push @b,$cmd;
		}
	}
	return @b;
}

sub _return_network {
my ($ipaddr,$netmask)=@_;
my (@a,@b,@c,$i);

	@a=split(/\./,$ipaddr);
	@b=split(/\./,$netmask);
	for($i=0;$i<4; $i++) {
		$c[$i]=int($a[$i]) & int($b[$i]);
	}
	return join(".",@c);
}

sub get_details {
my $self=shift;
my %args=@_;

	return(undef) if !exists($args{interface});
	return(undef) if !exists($self->{interfaces}->{$args{interface}});
	return $self->{interfaces}->{$args{interface}};
}

1;

